home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 32 / Mac Magazin and MacEasy Magazine CD - Issue 32.iso / Grafik & Text / OzTeX3.0 / MetaPost / Inputs / plain.mp < prev    next >
Text File  |  1996-08-24  |  15KB  |  552 lines
  1. % This file gives the macros for plain MetaPost
  2. % It contains all the features of plain METAFONT except those specific to
  3. % font-making.  (See The METAFONTbook by D.E. Knuth).
  4. % There are also a number macros labeling figures etc.
  5. string base_name, base_version; base_name="plain"; base_version="0.62";
  6.  
  7. message "Preloading the plain mem file, version "&base_version;
  8.  
  9. delimiters ();  % this makes parentheses behave like parentheses
  10. def upto = step 1 until enddef; % syntactic sugar
  11. def downto = step -1 until enddef;
  12. def exitunless expr c = exitif not c enddef;
  13. let relax = \;  % ignore the word `relax', as in TeX
  14. let \\ = \; % double relaxation is like single
  15. def ]] = ] ] enddef; % right brackets should be loners
  16. def -- = {curl 1}..{curl 1} enddef;
  17. def --- = .. tension infinity .. enddef;
  18. def ... = .. tension atleast 1 .. enddef;
  19.  
  20. def gobble primary g = enddef;
  21. primarydef g gobbled gg = enddef;
  22. def hide(text t) = exitif numeric begingroup t;endgroup; enddef;
  23. def ??? = hide(interim showstopping:=1; showdependencies) enddef;
  24. def stop expr s = message s; gobble readstring enddef;
  25.  
  26. warningcheck:=1;
  27. tracinglostchars:=1;
  28.  
  29. def interact = % sets up to make "show" commands stop
  30.  hide(showstopping:=1; tracingonline:=1) enddef;
  31.  
  32. def loggingall =        % puts tracing info into the log
  33.  tracingcommands:=3; tracingtitles:=1; tracingequations:=1;
  34.  tracingcapsules:=1; tracingspecs:=2; tracingchoices:=1; tracinglostchars:=1;
  35.  tracingstats:=1; tracingoutput:=1; tracingmacros:=1; tracingrestores:=1;
  36.  enddef;
  37.  
  38. def tracingall =        % turns on every form of tracing
  39.  tracingonline:=1; showstopping:=1; loggingall enddef;
  40.  
  41. def tracingnone =       % turns off every form of tracing
  42.  tracingcommands:=0; tracingtitles:=0; tracingequations:=0;
  43.  tracingcapsules:=0; tracingspecs:=0; tracingchoices:=0; tracinglostchars:=0;
  44.  tracingstats:=0; tracingoutput:=0; tracingmacros:=0; tracingrestores:=0;
  45.  enddef;
  46.  
  47.  
  48.  
  49. %% dash patterns
  50.  
  51. vardef dashpattern(text t) =
  52.   save on, off, w;
  53.   let on=_on_;
  54.   let off=_off_;
  55.   w = 0;
  56.   nullpicture t
  57. enddef;
  58.  
  59. tertiarydef p _on_ d =
  60.   begingroup save pic;
  61.   picture pic; pic=p;
  62.   addto pic doublepath (w,w)..(w+d,w);
  63.   w := w+d;
  64.   pic shifted (0,d)
  65.   endgroup
  66. enddef;
  67.  
  68. tertiarydef p _off_ d =
  69.   begingroup w:=w+d;
  70.   p shifted (0,d)
  71.   endgroup
  72. enddef;
  73.  
  74.  
  75.  
  76. %% basic constants and mathematical macros
  77.  
  78. % numeric constants
  79. newinternal eps,epsilon,infinity,_;
  80. eps := .00049;    % this is a pretty small positive number
  81. epsilon := 1/256/256;   % but this is the smallest
  82. infinity := 4095.99998;    % and this is the largest
  83. _ := -1; % internal constant to make macros unreadable but shorter
  84.  
  85. newinternal mitered, rounded, beveled, butt, squared;
  86. mitered:=0; rounded:=1; beveled:=2; % linejoin types
  87. butt:=0;    rounded:=1; squared:=2; % linecap types
  88.  
  89.  
  90. % pair constants
  91. pair right,left,up,down,origin;
  92. origin=(0,0); up=-down=(0,1); right=-left=(1,0);
  93.  
  94. % path constants
  95. path quartercircle,halfcircle,fullcircle,unitsquare;
  96. fullcircle = makepath pencircle;
  97. halfcircle = subpath (0,4) of fullcircle;
  98. quartercircle = subpath (0,2) of fullcircle;
  99. unitsquare=(0,0)--(1,0)--(1,1)--(0,1)--cycle;
  100.  
  101. % transform constants
  102. transform identity;
  103. for z=origin,right,up: z transformed identity = z; endfor
  104.  
  105. % color constants
  106. color black, white, red, green, blue, background;
  107. black = (0,0,0);
  108. white = (1,1,1);
  109. red = (1,0,0);
  110. green = (0,1,0);
  111. blue = (0,0,1);
  112. background = white;   % The user can reset this
  113.  
  114. % picture constants
  115. picture blankpicture,evenly,withdots;
  116. blankpicture=nullpicture; % `display blankpicture...'
  117. evenly=dashpattern(on 3 off 3); % `dashed evenly'
  118. withdots=dashpattern(off 2.5 on 0 off 2.5); % `dashed withdots'
  119.  
  120. % string constants
  121. string ditto, EOF;
  122. ditto = char 34; % ASCII double-quote mark
  123. EOF = char 0;    % end-of-file for readfrom and write..to
  124.  
  125. % pen constants
  126. pen pensquare,penrazor,penspeck;
  127. pensquare = makepen(unitsquare shifted -(.5,.5));
  128. penrazor = makepen((-.5,0)--(.5,0)--cycle);
  129. penspeck=pensquare scaled eps;
  130.  
  131. % nullary operators
  132. vardef whatever = save ?; ? enddef;
  133.  
  134. % unary operators
  135. let abs = length;
  136.  
  137. vardef round primary u =
  138.  if numeric u: floor(u+.5)
  139.  elseif pair u: (round xpart u, round ypart u)
  140.  else: u fi enddef;
  141.  
  142. vardef ceiling primary x = -floor(-x) enddef;
  143.  
  144. vardef byte primary s =
  145.  if string s: ASCII fi s enddef;
  146.  
  147. vardef dir primary d = right rotated d enddef;
  148.  
  149. vardef unitvector primary z = z/abs z enddef;
  150.  
  151. vardef inverse primary T =
  152.  transform T_; T_ transformed T = identity; T_ enddef;
  153.  
  154. vardef counterclockwise primary c =
  155.  if turningnumber c <= 0: reverse fi c enddef;
  156.  
  157. vardef tensepath expr r =
  158.  for k=0 upto length r - 1: point k of r --- endfor
  159.  if cycle r: cycle else: point infinity of r fi enddef;
  160.  
  161. vardef center primary p = .5[llcorner p, urcorner p] enddef;
  162.  
  163.  
  164.  
  165. % binary operators
  166.  
  167. primarydef x mod y = (x-y*floor(x/y)) enddef;
  168. primarydef x div y = floor(x/y) enddef;
  169. primarydef w dotprod z = (xpart w * xpart z + ypart w * ypart z) enddef;
  170.  
  171. primarydef x**y = if y=2: x*x else: takepower y of x fi enddef;
  172. def takepower expr y of x =
  173.  if x>0: mexp(y*mlog x)
  174.  elseif (x=0) and (y>0): 0
  175.  else: 1
  176.   if y=floor y:
  177.    if y>=0: for n=1 upto y: *x endfor
  178.    else: for n=_ downto y: /x endfor
  179.    fi
  180.   else: hide(errmessage "Undefined power: " & decimal x&"**"&decimal y)
  181.   fi fi enddef;
  182.  
  183. vardef direction expr t of p =
  184.  postcontrol t of p - precontrol t of p enddef;
  185.  
  186. vardef directionpoint expr z of p =
  187.  a_:=directiontime z of p;
  188.  if a_<0: errmessage("The direction doesn't occur"); fi
  189.  point a_ of p enddef;
  190.  
  191. secondarydef p intersectionpoint q =
  192.  begingroup save x_,y_; (x_,y_)=p intersectiontimes q;
  193.  if x_<0: errmessage("The paths don't intersect"); origin
  194.  else: .5[point x_ of p, point y_ of q] fi endgroup
  195. enddef;
  196.  
  197. tertiarydef p softjoin q =
  198.  begingroup c_:=fullcircle scaled 2join_radius shifted point 0 of q;
  199.  a_:=ypart(c_ intersectiontimes p); b_:=ypart(c_ intersectiontimes q);
  200.  if a_<0:point 0 of p{direction 0 of p} else: subpath(0,a_) of p fi
  201.   ... if b_<0:{direction infinity of q}point infinity of q
  202.    else: subpath(b_,infinity) of q fi endgroup enddef;
  203. newinternal join_radius,a_,b_; path c_;
  204.  
  205.  
  206. path cuttings;  % what got cut off
  207.  
  208. tertiarydef a cutbefore b =  % tries to cut as little as possible
  209.   begingroup save t;
  210.   (t, whatever) = a intersectiontimes b;
  211.   if t<0:
  212.     cuttings:=point 0 of a;
  213.     a
  214.   else: cuttings:= subpath (0,t) of a;
  215.     subpath (t,length a) of a
  216.   fi
  217.   endgroup
  218. enddef;
  219.  
  220. tertiarydef a cutafter b =
  221.   reverse (reverse a  cutbefore  b)
  222.   hide(cuttings:=reverse cuttings)
  223. enddef;
  224.  
  225.  
  226.  
  227. % special operators
  228. vardef incr suffix $ = $:=$+1; $ enddef;
  229. vardef decr suffix $ = $:=$-1; $ enddef;
  230.  
  231. def reflectedabout(expr w,z) =    % reflects about the line w..z
  232.  transformed
  233.   begingroup transform T_;
  234.   w transformed T_ = w;  z transformed T_ = z;
  235.   xxpart T_ = -yypart T_; xypart T_ = yxpart T_; % T_ is a reflection
  236.   T_ endgroup enddef;
  237.  
  238. def rotatedaround(expr z, d) =    % rotates d degrees around z
  239.  shifted -z rotated d shifted z enddef;
  240. let rotatedabout = rotatedaround;   % for roundabout people
  241.  
  242. vardef min(expr u)(text t) = % t is a list of numerics, pairs, or strings
  243.  save u_; setu_ u; for uu = t: if uu<u_: u_:=uu; fi endfor
  244.  u_ enddef;
  245.  
  246. vardef max(expr u)(text t) = % t is a list of numerics, pairs, or strings
  247.  save u_; setu_ u; for uu = t: if uu>u_: u_:=uu; fi endfor
  248.  u_ enddef;
  249.  
  250. def setu_ primary u =
  251.  if pair u: pair u_ elseif string u: string u_ fi;
  252.  u_=u enddef;
  253.  
  254. def flex(text t) =           % t is a list of pairs
  255.  hide(n_:=0; for z=t: z_[incr n_]:=z; endfor
  256.   dz_:=z_[n_]-z_1)
  257.  z_1 for k=2 upto n_-1: ...z_[k]{dz_} endfor ...z_[n_] enddef;
  258. newinternal n_; pair z_[],dz_;
  259.  
  260. def superellipse(expr r,t,l,b,s)=
  261.  r{up}...(s[xpart t,xpart r],s[ypart r,ypart t]){t-r}...
  262.  t{left}...(s[xpart t,xpart l],s[ypart l,ypart t]){l-t}...
  263.  l{down}...(s[xpart b,xpart l],s[ypart l,ypart b]){b-l}...
  264.  b{right}...(s[xpart b,xpart r],s[ypart r,ypart b]){r-b}...cycle enddef;
  265.  
  266. vardef interpath(expr a,p,q) =
  267.  for t=0 upto length p-1: a[point t of p, point t of q]
  268.   ..controls a[postcontrol t of p, postcontrol t of q]
  269.    and a[precontrol t+1 of p, precontrol t+1 of q] .. endfor
  270.  if cycle p: cycle
  271.  else: a[point infinity of p, point infinity of q] fi enddef;
  272.  
  273. vardef solve@#(expr true_x,false_x)= % @#(true_x)=true, @#(false_x)=false
  274.  tx_:=true_x; fx_:=false_x;
  275.  forever: x_:=.5[tx_,fx_]; exitif abs(tx_-fx_)<=tolerance;
  276.  if @#(x_): tx_ else: fx_ fi :=x_; endfor
  277.  x_ enddef; % now x_ is near where @# changes from true to false
  278. newinternal tolerance, tx_,fx_,x_; tolerance:=.01;
  279.  
  280. vardef buildcycle(text ll) =
  281.   save ta_, tb_, k_, i_, pp_; path pp_[];
  282.   k_=0;
  283.   for q=ll: pp_[incr k_]=q; endfor
  284.   i_=k_;
  285.   for i=1 upto k_:
  286.     (ta_[i], length pp_[i_]-tb_[i_]) =
  287.       pp_[i] intersectiontimes reverse pp_[i_];
  288.     if ta_[i]<0:
  289.       errmessage("Paths "& decimal i &" and "& decimal i_ &" don't intersect");
  290.     fi
  291.     i_ := i;
  292.   endfor
  293.   for i=1 upto k_: subpath (ta_[i],tb_[i]) of pp_[i] .. endfor
  294.     cycle
  295. enddef;
  296.  
  297.  
  298.  
  299. %% units of measure
  300.  
  301. mm=2.83464;      pt=0.99626;        dd=1.06601;      bp:=1;
  302. cm=28.34645;     pc=11.95517;       cc=12.79213;     in:=72;
  303.  
  304. vardef magstep primary m = mexp(46.67432m) enddef;
  305.  
  306.  
  307.  
  308. %% macros for drawing and filling
  309.  
  310. def drawoptions(text t) =
  311.   def _op_ = t enddef
  312. enddef;
  313.  
  314. linejoin:=rounded;               % parameters that effect drawing
  315. linecap:=rounded;
  316. miterlimit:=10;
  317.  
  318. drawoptions();
  319.  
  320. pen currentpen;
  321. picture currentpicture;
  322.  
  323. def fill expr c = addto currentpicture contour c _op_ enddef;
  324. def draw expr p =
  325.   addto currentpicture
  326.   if picture p:
  327.     also p
  328.   else:
  329.     doublepath p withpen currentpen
  330.   fi
  331.   _op_
  332. enddef;
  333. def filldraw expr c =
  334.   addto currentpicture contour c withpen currentpen
  335.   _op_ enddef;
  336. def drawdot expr z =
  337.   addto currentpicture contour makepath currentpen shifted z
  338.   _op_ enddef;
  339.  
  340. def unfill expr c = fill c withcolor background enddef;
  341. def undraw expr p = draw p withcolor background enddef;
  342. def unfilldraw expr c = filldraw c withcolor background enddef;
  343. def undrawdot expr z = drawdot z withcolor background enddef;
  344. def erase text t =
  345.   def _e_ = withcolor background hide(def _e_=enddef;) enddef;
  346.   t _e_
  347. enddef;
  348. def _e_= enddef;
  349.  
  350. def cutdraw text t =
  351.   begingroup interim linecap:=butt; draw t _e_; endgroup enddef;
  352.  
  353. vardef image(text t) =
  354.   save currentpicture;
  355.   picture currentpicture;
  356.   currentpicture := nullpicture;
  357.   t;
  358.   currentpicture
  359. enddef;
  360.  
  361. def pickup secondary q =
  362.  if numeric q: numeric_pickup_ else: pen_pickup_ fi q enddef;
  363. def numeric_pickup_ primary q =
  364.  if unknown pen_[q]: errmessage "Unknown pen"; clearpen
  365.  else: currentpen:=pen_[q];
  366.   pen_lft:=pen_lft_[q];
  367.   pen_rt:=pen_rt_[q];
  368.   pen_top:=pen_top_[q];
  369.   pen_bot:=pen_bot_[q];
  370.   currentpen_path:=pen_path_[q] fi; enddef;
  371. def pen_pickup_ primary q =
  372.   currentpen:=q;
  373.   pen_lft:=xpart penoffset down of currentpen;
  374.   pen_rt:=xpart penoffset up of currentpen;
  375.   pen_top:=ypart penoffset left of currentpen;
  376.   pen_bot:=ypart penoffset right of currentpen;
  377.   path currentpen_path; enddef;
  378. newinternal pen_lft,pen_rt,pen_top,pen_bot,pen_count_;
  379.  
  380. vardef savepen = pen_[incr pen_count_]=currentpen;
  381.  pen_lft_[pen_count_]=pen_lft;
  382.  pen_rt_[pen_count_]=pen_rt;
  383.  pen_top_[pen_count_]=pen_top;
  384.  pen_bot_[pen_count_]=pen_bot;
  385.  pen_path_[pen_count_]=currentpen_path;
  386.  pen_count_ enddef;
  387.  
  388. def clearpen = currentpen:=nullpen;
  389.  pen_lft:=pen_rt:=pen_top:=pen_bot:=0;
  390.  path currentpen_path;
  391.  enddef;
  392. def clear_pen_memory =
  393.  pen_count_:=0;
  394.  numeric pen_lft_[],pen_rt_[],pen_top_[],pen_bot_[];
  395.  pen currentpen,pen_[];
  396.  path currentpen_path, pen_path_[];
  397.  enddef;
  398.  
  399. vardef lft primary x = x + if pair x: (pen_lft,0) else: pen_lft fi enddef;
  400. vardef rt primary x = x + if pair x: (pen_rt,0) else: pen_rt fi enddef;
  401. vardef top primary y = y + if pair y: (0,pen_top) else: pen_top fi enddef;
  402. vardef bot primary y = y + if pair y: (0,pen_bot) else: pen_bot fi enddef;
  403.  
  404. vardef penpos@#(expr b,d) =
  405.  (x@#r-x@#l,y@#r-y@#l)=(b,0) rotated d;
  406.  x@#=.5(x@#l+x@#r); y@#=.5(y@#l+y@#r) enddef;
  407.  
  408. def penstroke text t =
  409.  forsuffixes e = l,r: path_.e:=t; endfor
  410.  fill path_.l -- reverse path_.r -- cycle enddef;
  411. path path_.l,path_.r;
  412.  
  413.  
  414.  
  415. %% High level drawing commands
  416.  
  417. newinternal ahlength, ahangle;
  418. ahlength := 4;            % default arrowhead length 4bp
  419. ahangle := 45;           % default head angle 45 degrees
  420.  
  421. vardef arrowhead expr p =
  422.   save q,e; path q; pair e;
  423.   e = point length p of p;
  424.   q = gobble(p shifted -e cutafter makepath(pencircle scaled 2ahlength))
  425.     cuttings;
  426.   (q rotated .5ahangle & reverse q rotated -.5ahangle -- cycle)  shifted e
  427. enddef;
  428.  
  429. path _apth;
  430. def drawarrow expr p = _apth:=p; _finarr enddef;
  431. def drawdblarrow expr p = _apth:=p; _findarr enddef;
  432.  
  433. def _finarr text t =
  434.   draw _apth t;
  435.   filldraw arrowhead _apth  t
  436. enddef;
  437.  
  438. def _findarr text t =
  439.   draw _apth t;
  440.   fill arrowhead _apth withpen currentpen  t;
  441.   fill arrowhead  reverse _apth  withpen currentpen  t
  442. enddef;
  443.  
  444.  
  445.  
  446. %% macros for labels
  447.  
  448. newinternal bboxmargin; bboxmargin:=2bp;
  449.  
  450. vardef bbox primary p =
  451.   llcorner p-(bboxmargin,bboxmargin) -- lrcorner p+(bboxmargin,-bboxmargin)
  452.   -- urcorner p+(bboxmargin,bboxmargin) -- ulcorner p+(-bboxmargin,bboxmargin)
  453.   -- cycle
  454. enddef;
  455.  
  456. string defaultfont;
  457. newinternal defaultscale, labeloffset;
  458. defaultfont = "cmr10";
  459. defaultscale := 1;
  460. labeloffset := 3bp;
  461.  
  462. vardef thelabel@#(expr s,z) =  % Position s near z
  463.   save p; picture p;
  464.   if picture s:  p=s
  465.   else:    p = s infont defaultfont scaled defaultscale
  466.   fi;
  467.   p shifted (z + labeloffset*laboff@# -
  468.      (labxf@#*lrcorner p + labyf@#*ulcorner p
  469.        + (1-labxf@#-labyf@#)*llcorner p
  470.      )
  471.   )
  472. enddef;
  473.  
  474. def label = draw thelabel enddef;
  475. vardef dotlabel@#(expr s,z) =
  476.   label@#(s,z);
  477.   interim linecap:=rounded;
  478.   draw z withpen pencircle scaled 3bp;
  479. enddef;
  480. def makelabel = dotlabel enddef;
  481.  
  482. pair laboff, laboff.lft, laboff.rt, laboff.top, laboff.bot;
  483. pair laboff.ulft, laboff.llft, laboff.urt, laboff.lrt;
  484. laboff    =(0,0);    labxf    =.5;  labyf    =.5;
  485. laboff.lft=(-1,0);   labxf.lft=1;   labyf.lft=.5;
  486. laboff.rt =(1,0);    labxf.rt =0;   labyf.rt =.5;
  487. laboff.bot=(0,-1);   labxf.bot=.5;  labyf.bot=1;
  488. laboff.top=(0,1);    labxf.top=.5;  labyf.top=0;
  489. laboff.ulft=(-.7,.7);labxf.ulft=1;  labyf.ulft=0;
  490. laboff.urt=(.7,.7);  labxf.urt=0;   labyf.urt=0;
  491. laboff.llft=-(.7,.7);labxf.llft=1;  labyf.llft=1;
  492. laboff.lrt=(.7,-.7); labxf.lrt=0;   labyf.lrt=1;
  493.  
  494. vardef labels@#(text t) =
  495.  forsuffixes $=t:
  496.    label@#(str$,z$); endfor
  497.  enddef;
  498. vardef dotlabels@#(text t) =
  499.  forsuffixes $=t:
  500.    dotlabel@#(str$,z$); endfor
  501.  enddef;
  502. vardef penlabels@#(text t) =
  503.  forsuffixes $$=l,,r: forsuffixes $=t:
  504.    makelabel@#(str$.$$,z$.$$); endfor endfor
  505.  enddef;
  506.  
  507.  
  508. def range expr x = numtok[x] enddef;
  509. def numtok suffix x=x enddef;
  510. tertiarydef m thru n =
  511.  m for x=m+1 step 1 until n: , numtok[x] endfor enddef;
  512.  
  513.  
  514.  
  515. %% Overall adminstration
  516.  
  517. string extra_beginfig, extra_endfig;
  518. extra_beginfig = extra_endfig = "";
  519.  
  520. def beginfig(expr c) =
  521.   begingroup
  522.   charcode:=c;
  523.   clearxy; clearit; clearpen;
  524.   pickup defaultpen;
  525.   drawoptions();
  526.   scantokens extra_beginfig;
  527. enddef;
  528.  
  529. def endfig =
  530.   scantokens extra_endfig;
  531.   shipit;
  532.   endgroup
  533. enddef;
  534.  
  535.  
  536. %% last-minute items
  537.  
  538. vardef z@#=(x@#,y@#) enddef;
  539.  
  540. def clearxy = save x,y enddef;
  541. def clearit = currentpicture:=nullpicture enddef;
  542. def shipit = shipout currentpicture enddef;
  543.  
  544. let bye = end; outer end,bye;
  545.  
  546. clear_pen_memory;     % initialize the `savepen' mechanism
  547. clearit;
  548.  
  549. newinternal defaultpen;
  550. pickup pencircle scaled .5bp;  % set default line width
  551. defaultpen := savepen;
  552.